home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / packages / spell.el < prev    next >
Encoding:
Text File  |  1995-03-25  |  4.5 KB  |  135 lines
  1. ;;; spell.el --- spelling correction interface for Emacs.
  2. ;; Keywords: wp, unix
  3.  
  4. ;; Copyright (C) 1985 Free Software Foundation, Inc.
  5.  
  6. ;; This file is part of XEmacs.
  7.  
  8. ;; XEmacs is free software; you can redistribute it and/or modify it
  9. ;; under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; XEmacs is distributed in the hope that it will be useful, but
  14. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16. ;; General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  20. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22.  
  23. (defvar spell-command "spell"
  24.   "*Command to run the spell program.")
  25.  
  26. (defvar spell-filter nil
  27.   "*Filter function to process text before passing it to spell program.
  28. This function might remove text-processor commands.
  29. nil means don't alter the text before checking it.")
  30.  
  31. (defun spell-buffer ()
  32.   "Check spelling of every word in the buffer.
  33. For each incorrect word, you are asked for the correct spelling
  34. and then put into a query-replace to fix some or all occurrences.
  35. If you do not want to change a word, just give the same word
  36. as its \"correct\" spelling; then the query replace is skipped."
  37.   (interactive)
  38.   (spell-region (point-min) (point-max) "buffer"))
  39.  
  40. (defun spell-word ()
  41.   "Check spelling of word at or before point.
  42. If it is not correct, ask user for the correct spelling
  43. and query-replace the entire buffer to substitute it."
  44.   (interactive)
  45.   (let (beg end spell-filter)
  46.     (save-excursion
  47.      (if (not (looking-at "\\<"))
  48.      (forward-word -1))
  49.      (setq beg (point))
  50.      (forward-word 1)
  51.      (setq end (point)))
  52.     (spell-region beg end (buffer-substring beg end))))
  53.  
  54. (defun spell-region (start end &optional description)
  55.   "Like spell-buffer but applies only to region.
  56. Used in a program, applies from START to END.
  57. DESCRIPTION is an optional string naming the unit being checked:
  58. for example, \"word\"."
  59.   (interactive "r")
  60.   (let ((filter spell-filter)
  61.     (buf (get-buffer-create " *temp*")))
  62.     (save-excursion
  63.      (set-buffer buf)
  64.      (widen)
  65.      (erase-buffer))
  66.     (message "Checking spelling of %s..." (or description "region"))
  67.     (if (and (null filter) (= ?\n (char-after (1- end))))
  68.     (if (string= "spell" spell-command)
  69.         (call-process-region start end "spell" nil buf)
  70.       (call-process-region start end shell-file-name
  71.                    nil buf nil "-c" spell-command))
  72.       (let ((oldbuf (current-buffer)))
  73.     (save-excursion
  74.      (set-buffer buf)
  75.      (insert-buffer-substring oldbuf start end)
  76.      (or (bolp) (insert ?\n))
  77.      (if filter (funcall filter))
  78.      (if (string= "spell" spell-command)
  79.          (call-process-region (point-min) (point-max) "spell" t buf)
  80.        (call-process-region (point-min) (point-max) shell-file-name
  81.                 t buf nil "-c" spell-command)))))
  82.     (message "Checking spelling of %s...%s"
  83.          (or description "region")
  84.          (if (save-excursion
  85.           (set-buffer buf)
  86.           (> (buffer-size) 0))
  87.          "not correct"
  88.            "correct"))
  89.     (let (word newword
  90.       (case-fold-search t)
  91.       (case-replace t))
  92.       (while (save-excursion
  93.           (set-buffer buf)
  94.           (> (buffer-size) 0))
  95.     (save-excursion
  96.      (set-buffer buf)
  97.      (goto-char (point-min))
  98.      (setq word (downcase
  99.              (buffer-substring (point)
  100.                        (progn (end-of-line) (point)))))
  101.      (forward-char 1)
  102.      (delete-region (point-min) (point))
  103.      (setq newword
  104.            (read-input (concat "`" word
  105.                    "' not recognized; edit a replacement: ")
  106.                word))
  107.      (flush-lines (concat "^" (regexp-quote word) "$")))
  108.     (if (not (equal word newword))
  109.         (progn
  110.          (goto-char (point-min))
  111.          (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b")
  112.                    newword)))))))
  113.  
  114.  
  115. (defun spell-string (string)
  116.   "Check spelling of string supplied as argument."
  117.   (interactive "sSpell string: ")
  118.   (let ((buf (get-buffer-create " *temp*")))
  119.     (save-excursion
  120.      (set-buffer buf)
  121.      (widen)
  122.      (erase-buffer)
  123.      (insert string "\n")
  124.      (if (string= "spell" spell-command)
  125.      (call-process-region (point-min) (point-max) "spell"
  126.                   t t)
  127.        (call-process-region (point-min) (point-max) shell-file-name
  128.                 t t nil "-c" spell-command))
  129.      (if (= 0 (buffer-size))
  130.      (message "%s is correct" string)
  131.        (goto-char (point-min))
  132.        (while (search-forward "\n" nil t)
  133.      (replace-match " "))
  134.        (message "%sincorrect" (buffer-substring 1 (point-max)))))))
  135.